home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / debug / describe.scm < prev    next >
Text File  |  1995-10-13  |  1KB  |  42 lines
  1. ; Copyright (c) 1993, 1994 Richard Kelsey and Jonathan Rees.  See file COPYING.
  2.  
  3.  
  4. (define (describe x)
  5.   (if (and (stob? x)
  6.        (< (stob-type x) least-b-vector-type))
  7.       (let ((tag (string-append (number->string x) ": "))
  8.         (len (bytes->cells (stob-length-in-bytes x))))
  9.     (do ((i -1 (+ i 1)))
  10.         ((= i len))
  11.       (describe-1 (stob-ref x i) tag)))
  12.       (describe-1 x "")))
  13.  
  14.  
  15.  
  16. (define (describe-1 x addr)
  17.   (cond ((fixnum? x) (display " fixnum ") (write (extract-fixnum x)))
  18.     ((header? x)
  19.      (display addr)
  20.      (if (immutable-header? x)
  21.          (display " immutable"))
  22.      (display " header ")
  23.      (let ((type (header-type x)))
  24.        (if (< type stob-count)
  25.            (write (vector-ref stob type))
  26.            (write type)))
  27.      (display " ")
  28.      (write (header-length-in-bytes x)))
  29.     ((immediate? x)
  30.      (cond (else
  31.         (display " immediate ")
  32.         (let ((type (immediate-type x)))
  33.           (if (< type imm-count)
  34.               (write (vector-ref imm type))
  35.               (write type)))
  36.         (display " ")
  37.         (write (immediate-info x)))))
  38.     ((stob? x)
  39.      (display " stob ") (write x))
  40.     (else (display " ? ") (write x)))
  41.   (newline))
  42.